Tasa de Política Monetaria

tpm <- read.csv("tpm.csv", sep = ";", header = T)

colnames(tpm)[2:2] <- c("TPM")

tpm$TPM <- gsub(",", ".", tpm$TPM)

tpm$TPM <- as.numeric(tpm$TPM)

tpm <- tpm$TPM

tpm <- tpm

tpm.ts <- ts(tpm, start = c(2023,1), frequency = 365)
print(tpm.ts)
## Time Series:
## Start = c(2023, 1) 
## End = c(2023, 365) 
## Frequency = 365 
##   [1] 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00
##  [16] 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00
##  [31] 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00
##  [46] 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00
##  [61] 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 9.00 8.50
##  [76] 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50
##  [91] 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50 8.50
## [106] 8.50 8.50 8.50 8.50 8.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50
## [121] 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50
## [136] 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50
## [151] 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50 7.50
## [166] 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00
## [181] 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00
## [196] 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 7.00 6.50 6.50 6.50
## [211] 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50
## [226] 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50
## [241] 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50
## [256] 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50
## [271] 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50
## [286] 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.50 6.25 6.25
## [301] 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25
## [316] 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25
## [331] 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25
## [346] 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.25 6.00 6.00 6.00 6.00 6.00 6.00
## [361] 6.00 6.00 6.00 6.00 6.00
plot.ts(tpm.ts, main = "Fig 2: Tasa de Política Monetaria 2023", col = "blue", ylab = "TPM", xlab = " (días)")

Tasa Básica Pasiva

tbp <- read.csv("tbp.csv", sep = ";", header = T)

colnames(tbp)[2:2] <- c("TBP")

tbp$TBP <- gsub(",", ".", tbp$TBP)

tbp$TBP <- as.numeric(tbp$TBP)

tbp <- tbp$TBP

tbp.ts <-ts(tbp, start = c(2023, 1), frequency = 365)

plot.ts(tbp.ts, main = "Fig 3: Tasa Básica Pasiva 2023", col = "blue", ylab = "TPM", xlab = " (días)")

TEST para ver la estacionalidad

adf.test(tpm.ts)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  tpm.ts
## Dickey-Fuller = -1.7879, Lag order = 7, p-value = 0.6665
## alternative hypothesis: stationary
adf.test(tbp.ts)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  tbp.ts
## Dickey-Fuller = -3.288, Lag order = 7, p-value = 0.07326
## alternative hypothesis: stationary

Por tanto, como los p-valores son superiores a 0.05, las series no son estacionarias

#adf.test(tpm.spl.ts)
#adf.test(tbp.spl.ts)

Tipo de cambio

cola <- function(x){
  if(nrow(x) > 60){
    return(x <- tail(x, 365))
  } else{
    return(x <- tail(x, 12))
  }
}

#cola <- function(x){
  #return(x)
#}

Lectura de los datos

Tasa de cambio CRC/USD

cambio <- read.csv("cambio2.csv", sep = ";", header = F)

cambio <- cola(cambio)

colnames(cambio)[1:2] <- c("Compra", "Venta")

precio <- (cambio$Compra + cambio$Venta)/2

precio.ts <- ts(precio, start = c(2023, 1), frequency = 365)

Transformación

rend.log <- diff(log(precio.ts))
acf(rend.log)

adf.test(rend.log)
## Warning in adf.test(rend.log): p-value smaller than printed p-value
## 
##  Augmented Dickey-Fuller Test
## 
## data:  rend.log
## Dickey-Fuller = -7.7149, Lag order = 7, p-value = 0.01
## alternative hypothesis: stationary

Es estacionario.

Separación datos

# Endogena
estacionaria <- cbind(rend.log)
  
muestra_end <- window(estacionaria,
                      start = c(2023, 1),
                      end = c(2023,365),
                      freq = 365)
## Warning in window.default(x, ...): 'start' value not changed
# Exogena
muestra_exo <- ts.intersect(tpm.ts,tbp.ts)

   # Exogena para la estimacion
   muestra_exo1 <- window(muestra_exo, 
                          start = c(2023, 1),
                          end = c(2023,335),
                          freq = 365)

   # Exogena para la proyeccion
   muestra_exo2 <- window(muestra_exo,
                          start = c(2023, 336),
                          end = c(2023, 365),
                          freq = 365)

Correlograma

# Correlograma
ts_cor(estacionaria)

A partir de los gráficos se identifica que q = 1 y p = 1. Entonces es un modelo arimax(1,1,1)

Modelo ARIMAX

#arimax <- arima(muestra_end,
                #order = c(1, 1, 1), 
                #xreg = muestra_exo1,
                #method = "ML")
#summary(arimax)

Análisis exploratorio

ACF

acf(tpm.ts, lag = 365)

Suavizar

# Definir el tamaño de la ventana de la media móvil
k <- 30  # Ventana de 30 días

# Crear un filtro de media móvil
filtro <- rep(1/k, k)

# Aplicar la media móvil a la serie temporal
tpm.suavizado <- filter(tpm.ts, filtro, sides = 1)  # "sides = 2" realiza un suavizado centrado

# Visualizar los resultados
plot(tpm.ts, col = "blue", lwd = 2, ylab = "TPM", main = "Serie Original vs Suavizada")
lines(tpm.suavizado, col = "red", lwd = 2)
legend("topright", legend = c("Original", "Suavizado (30 días)"), col = c("blue", "red"), lwd = 2)

`

# Crear un filtro ponderado
k <- 60 # Tamaño de la ventana
pesos <- seq(1, k) / sum(seq(1, k))  # Ponderaciones
tpm.suavizado_ponderado <- filter(tpm.ts, pesos, sides = 2)

# Visualizar resultados
plot(tpm.ts, col = "blue", lwd = 2, ylab = "TPM", main = "Serie Original vs Suavizada")
lines(tpm.suavizado_ponderado, col = "red", lwd = 2)
legend("topright", legend = c("Original", "Suavizado Ponderado"), col = c("blue", "red"), lwd = 2)

# Suavizado por splines
tpm.spl <- smooth.spline(time(tpm.ts), tpm.ts, spar = 0.65)  # Ajustar el parámetro spar para controlar la suavidad

# Visualizar resultados
plot(tpm.ts, col = "blue", lwd = 2, ylab = "TPM", main = "Serie Original vs Suavizada por Splines")
lines(tpm.spl, col = "red", lwd = 2)
legend("topright", legend = c("Original", "Suavizado por Splines"), col = c("blue", "red"), lwd = 2)

tpm.spl.ts <- ts(tpm.spl$y, start = start(tpm.ts), frequency = frequency(tpm.ts))

# Verificar el resultado
print(tpm.spl.ts)
## Time Series:
## Start = c(2023, 1) 
## End = c(2023, 365) 
## Frequency = 365 
##   [1] 8.999367 8.999348 8.999330 8.999312 8.999295 8.999280 8.999267 8.999257
##   [9] 8.999251 8.999251 8.999258 8.999273 8.999299 8.999337 8.999389 8.999458
##  [17] 8.999547 8.999656 8.999790 8.999950 9.000141 9.000363 9.000620 9.000915
##  [25] 9.001250 9.001628 9.002050 9.002518 9.003033 9.003595 9.004205 9.004861
##  [33] 9.005563 9.006306 9.007088 9.007901 9.008737 9.009589 9.010445 9.011293
##  [41] 9.012115 9.012895 9.013610 9.014238 9.014753 9.015122 9.015310 9.015282
##  [49] 9.014999 9.014416 9.013486 9.012157 9.010377 9.008088 9.005232 9.001748
##  [57] 8.997576 8.992652 8.986915 8.980305 8.972764 8.964236 8.954683 8.944071
##  [65] 8.932366 8.919543 8.905615 8.890605 8.874545 8.857503 8.839559 8.820819
##  [73] 8.801492 8.781815 8.762024 8.742350 8.723005 8.704194 8.686095 8.668776
##  [81] 8.652279 8.636623 8.621754 8.607598 8.594082 8.581117 8.568560 8.556254
##  [89] 8.544035 8.531715 8.519099 8.505994 8.492203 8.477524 8.461755 8.444694
##  [97] 8.426157 8.405962 8.383939 8.359979 8.333985 8.305860 8.275534 8.243040
## [105] 8.208438 8.171816 8.133383 8.093375 8.052085 8.010018 7.967736 7.925798
## [113] 7.884734 7.844943 7.806795 7.770619 7.736593 7.704856 7.675521 7.648599
## [121] 7.624075 7.601932 7.582141 7.564608 7.549222 7.535872 7.524422 7.514734
## [129] 7.506669 7.500089 7.494844 7.490788 7.487772 7.485654 7.484293 7.483550
## [137] 7.483293 7.483394 7.483725 7.484159 7.484580 7.484873 7.484924 7.484627
## [145] 7.483875 7.482565 7.480602 7.477895 7.474354 7.469888 7.464422 7.457883
## [153] 7.450202 7.441336 7.431248 7.419902 7.407271 7.393373 7.378239 7.361910
## [161] 7.344468 7.326008 7.306652 7.286633 7.266216 7.245662 7.225232 7.205174
## [169] 7.185734 7.167133 7.149487 7.132887 7.117408 7.103061 7.089838 7.077733
## [177] 7.066728 7.056758 7.047746 7.039612 7.032251 7.025557 7.019421 7.013732
## [185] 7.008365 7.003193 6.998088 6.992921 6.987564 6.981891 6.975781 6.969119
## [193] 6.961786 6.953670 6.944682 6.934733 6.923746 6.911664 6.898438 6.884034
## [201] 6.868478 6.851811 6.834074 6.815331 6.795735 6.775460 6.754705 6.733756
## [209] 6.712922 6.692488 6.672639 6.653535 6.635337 6.618185 6.602138 6.587235
## [217] 6.573507 6.560943 6.549524 6.539231 6.530037 6.521892 6.514737 6.508513
## [225] 6.503157 6.498603 6.494788 6.491647 6.489118 6.487137 6.485643 6.484581
## [233] 6.483898 6.483542 6.483470 6.483638 6.484004 6.484538 6.485209 6.485988
## [241] 6.486848 6.487769 6.488732 6.489721 6.490726 6.491735 6.492741 6.493734
## [249] 6.494709 6.495665 6.496599 6.497508 6.498394 6.499254 6.500091 6.500903
## [257] 6.501693 6.502459 6.503203 6.503922 6.504616 6.505283 6.505919 6.506521
## [265] 6.507081 6.507591 6.508043 6.508428 6.508731 6.508940 6.509039 6.509006
## [273] 6.508821 6.508462 6.507907 6.507128 6.506096 6.504782 6.503154 6.501179
## [281] 6.498826 6.496060 6.492850 6.489162 6.484965 6.480234 6.474943 6.469071
## [289] 6.462605 6.455535 6.447857 6.439594 6.430776 6.421431 6.411601 6.401366
## [297] 6.390821 6.380069 6.369257 6.358543 6.348071 6.337938 6.328224 6.319011
## [305] 6.310372 6.302335 6.294923 6.288149 6.282009 6.276492 6.271589 6.267286
## [313] 6.263554 6.260364 6.257682 6.255474 6.253704 6.252334 6.251326 6.250640
## [321] 6.250238 6.250080 6.250126 6.250336 6.250672 6.251093 6.251559 6.252032
## [329] 6.252469 6.252829 6.253072 6.253156 6.253037 6.252672 6.252017 6.251027
## [337] 6.249657 6.247860 6.245592 6.242808 6.239466 6.235521 6.230934 6.225667
## [345] 6.219685 6.212968 6.205502 6.197271 6.188266 6.178503 6.168004 6.156803
## [353] 6.144980 6.132627 6.119839 6.106712 6.093343 6.079829 6.066254 6.052649
## [361] 6.039033 6.025419 6.011812 5.998208 5.984609
tpm_dif1 <- diff(log(tpm.spl.ts))
acf(tpm_dif1)

acf(tpm.spl.ts, lag = 365)

tpm.spl.dif1 <- diff(tpm.spl.ts, differences = 1)
plot(tpm.spl.dif1)

ACF

acf(tbp.ts, lag = 365)

Suavizar

# Definir el tamaño de la ventana de la media móvil
k <- 7  # Ventana de 30 días

# Crear un filtro de media móvil
filtro <- rep(1/k, k)

# Aplicar la media móvil a la serie temporal
tbp.suavizado <- filter(tbp.ts, filtro, sides = 1)  # "sides = 2" realiza un suavizado centrado

# Visualizar los resultados
plot(tbp.ts, col = "blue", lwd = 2, ylab = "TPM", main = "Serie Original vs Suavizada")
lines(tbp.suavizado, col = "red", lwd = 2)
legend("topright", legend = c("Original", "Suavizado (30 días)"), col = c("blue", "red"), lwd = 2)

# Crear un filtro ponderado
k <- 14 # Tamaño de la ventana
pesos <- seq(1, k) / sum(seq(1, k))  # Ponderaciones
tbp.suavizado_ponderado <- filter(tbp.ts, pesos, sides = 2)

# Visualizar resultados
plot(tbp.ts, col = "blue", lwd = 2, ylab = "TPM", main = "Serie Original vs Suavizada")
lines(tbp.suavizado_ponderado, col = "red", lwd = 2)
legend("topright", legend = c("Original", "Suavizado Ponderado"), col = c("blue", "red"), lwd = 2)

# Suavizado por splines
tbp.spl <- smooth.spline(time(tbp.ts), tbp.ts, spar = 0.65)  # Ajustar el parámetro spar para controlar la suavidad

# Visualizar resultados
plot(tbp.ts, col = "blue", lwd = 2, ylab = "TPM", main = "Serie Original vs Suavizada por Splines")
lines(tbp.spl, col = "red", lwd = 2)
legend("topright", legend = c("Original", "Suavizado por Splines"), col = c("blue", "red"), lwd = 2)

tbp.spl.ts <- ts(tbp.spl$y, start = start(tbp.ts), frequency = frequency(tbp.ts))

# Verificar el resultado
print(tbp.spl.ts)
## Time Series:
## Start = c(2023, 1) 
## End = c(2023, 365) 
## Frequency = 365 
##   [1] 6.324188 6.329868 6.335555 6.341259 6.346993 6.352772 6.358616 6.364540
##   [9] 6.370554 6.376665 6.382879 6.389201 6.395629 6.402157 6.408781 6.415503
##  [17] 6.422327 6.429254 6.436281 6.443403 6.450616 6.457914 6.465285 6.472716
##  [25] 6.480194 6.487688 6.495168 6.502603 6.509976 6.517268 6.524462 6.531542
##  [33] 6.538490 6.545292 6.551934 6.558421 6.564759 6.570957 6.577022 6.582971
##  [41] 6.588821 6.594592 6.600300 6.605964 6.611600 6.617213 6.622807 6.628387
##  [49] 6.633952 6.639493 6.644999 6.650451 6.655815 6.661052 6.666123 6.670993
##  [57] 6.675628 6.679994 6.684059 6.687798 6.691185 6.694202 6.696834 6.699075
##  [65] 6.700914 6.702346 6.703377 6.704016 6.704275 6.704164 6.703700 6.702895
##  [73] 6.701768 6.700340 6.698630 6.696659 6.694445 6.692010 6.689372 6.686549
##  [81] 6.683558 6.680418 6.677149 6.673775 6.670319 6.666808 6.663279 6.659775
##  [89] 6.656338 6.653010 6.649837 6.646862 6.644127 6.641661 6.639492 6.637646
##  [97] 6.636144 6.635006 6.634247 6.633869 6.633868 6.634242 6.634985 6.636081
## [105] 6.637511 6.639258 6.641298 6.643612 6.646177 6.648960 6.651931 6.655058
## [113] 6.658304 6.661630 6.664989 6.668336 6.671613 6.674762 6.677723 6.680439
## [121] 6.682853 6.684906 6.686542 6.687699 6.688317 6.688342 6.687741 6.686486
## [129] 6.684550 6.681910 6.678571 6.674542 6.669832 6.664457 6.658436 6.651790
## [137] 6.644559 6.636788 6.628520 6.619802 6.610678 6.601193 6.591397 6.581348
## [145] 6.571108 6.560737 6.550285 6.539803 6.529341 6.518946 6.508671 6.498563
## [153] 6.488667 6.479008 6.469606 6.460479 6.451642 6.443087 6.434803 6.426776
## [161] 6.418986 6.411411 6.404029 6.396819 6.389761 6.382834 6.376018 6.369291
## [169] 6.362629 6.356011 6.349411 6.342803 6.336162 6.329468 6.322699 6.315835
## [177] 6.308857 6.301753 6.294514 6.287132 6.279606 6.271939 6.264134 6.256194
## [185] 6.248133 6.239964 6.231704 6.223374 6.214997 6.206595 6.198182 6.189772
## [193] 6.181375 6.173006 6.164677 6.156399 6.148185 6.140035 6.131950 6.123929
## [201] 6.115974 6.108086 6.100265 6.092512 6.084819 6.077178 6.069582 6.062028
## [209] 6.054516 6.047042 6.039592 6.032149 6.024699 6.017224 6.009708 6.002133
## [217] 5.994485 5.986747 5.978907 5.970952 5.962870 5.954663 5.946337 5.937897
## [225] 5.929345 5.920682 5.911914 5.903056 5.894126 5.885143 5.876123 5.867075
## [233] 5.858009 5.848931 5.839852 5.830781 5.821728 5.812700 5.803702 5.794740
## [241] 5.785824 5.776968 5.768191 5.759510 5.750933 5.742468 5.734121 5.725898
## [249] 5.717800 5.709826 5.701977 5.694251 5.686649 5.679171 5.671830 5.664639
## [257] 5.657613 5.650766 5.644113 5.637669 5.631449 5.625463 5.619721 5.614230
## [265] 5.608993 5.604010 5.599284 5.594812 5.590578 5.586565 5.582754 5.579124
## [273] 5.575654 5.572324 5.569113 5.566006 5.562987 5.560043 5.557162 5.554332
## [281] 5.551539 5.548760 5.545972 5.543150 5.540268 5.537304 5.534233 5.531036
## [289] 5.527703 5.524231 5.520619 5.516881 5.513034 5.509095 5.505082 5.501013
## [297] 5.496908 5.492785 5.488671 5.484590 5.480566 5.476611 5.472734 5.468944
## [305] 5.465250 5.461651 5.458147 5.454738 5.451418 5.448185 5.445032 5.441956
## [313] 5.438954 5.436022 5.433158 5.430356 5.427611 5.424917 5.422269 5.419663
## [321] 5.417097 5.414564 5.412060 5.409577 5.407107 5.404644 5.402179 5.399707
## [329] 5.397226 5.394734 5.392232 5.389722 5.387216 5.384731 5.382280 5.379877
## [337] 5.377533 5.375260 5.373070 5.370970 5.368966 5.367062 5.365264 5.363573
## [345] 5.361992 5.360523 5.359165 5.357919 5.356784 5.355759 5.354840 5.354025
## [353] 5.353307 5.352680 5.352138 5.351672 5.351274 5.350936 5.350650 5.350405
## [361] 5.350192 5.350002 5.349827 5.349662 5.349499
tbp_dif1 <- diff(log(tbp.spl.ts))
acf(tbp_dif1, lag = 100)